home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / tpznewg.zip / SERIELLI.U < prev    next >
Text File  |  1990-04-06  |  45KB  |  1,454 lines
  1. (*************************************************************************)
  2. (*                                                                       *)
  3. (*  Unit SeriellInterface                                                *)
  4. (*                                                                       *)
  5. (*************************************************************************)
  6. (*                                                                       *)
  7. (* Programmierer ........ Stefan Graf / 4600 Dortmund 1 / BRD            *)
  8. (*                                                                       *)
  9. (* Programmiersprache ... Turbo-Pascal 5.0                               *)
  10. (*                                                                       *)
  11. (* Projekt .............. Verwaltung der ser. Schnittstellen im IBM      *)
  12. (*                                                                       *)
  13. (* Erststellt am ........ 02.07.89                                       *)
  14. (*                                                                       *)
  15. (* letzte Änderung am ... 06.04.90                                       *)
  16. (*                                                                       *)
  17. (* Revision ............. 1.13                                           *)
  18. (*                                                                       *)
  19. (*************************************************************************)
  20. (*                                                                       *)
  21. (* Beschreibung:                                                         *)
  22. (*                                                                       *)
  23. (* Programmierung und Verwaltung von bis zu 8 seriellen Schnittstellen   *)
  24. (* im IBM XT/AT/386.                                                     *)
  25. (* Alle Schnittstellen können bei Bedarf mit einer interrupt-gesteuerten *)
  26. (* Empfangsroutinen betrieben werden.                                    *)
  27. (* Die erweiterten Interrupt's des AT's oder der 386 werden unterstützt. *)
  28. (*                                                                       *)
  29. (* Änderungen                                                            *)
  30. (*                                                                       *)
  31. (*   1.01 Procedure SetStatusMask und Function SeriellStatus eingeführt  *)
  32. (*                                                                       *)
  33. (*   1.02 Parameter TransmitMask eingeführt.                             *)
  34. (*                                                                       *)
  35. (*   1.03 Beim Deinstallieren des Handlers werden nur noch die Leitungen *)
  36. (*        die mit der <Transmittmaske> definiert werden, zurückgesetzt.  *)
  37. (*                                                                       *)
  38. (*   1.04 Neue Funktionen definiert.                                     *)
  39. (*                                                                       *)
  40. (*   1.10 Neue Funktionen definiert.                                     *)
  41. (*                                                                       *)
  42. (*************************************************************************)
  43.  
  44. {$R-}
  45. {$S-}
  46. {$O-}
  47.  
  48. UNIT SeriellInterface;
  49.  
  50. INTERFACE
  51.  
  52. (*************************************************************************)
  53.  
  54.   CONST
  55.     DSRInput  = $20;
  56.     CTSInput  = $10;
  57.     CDInput   = $80;
  58.     RIInput   = $40;
  59.     DTROutput = $01;
  60.     RTSOutput = $02;
  61.  
  62.     MaxKanal       = 8;      (* Max. sind acht Handler gleichzeitig nutzbar   *)
  63.  
  64.     NotInstall     = 20000;  (* Der Handler wurde noch nicht installiert      *)
  65.     NoHandler      = 20001;  (* Es ist kein freier Handler mehr vorhanden     *)
  66.     NoChip         = 20002;  (* An der Adresse liegt kein ser. Baustein       *)
  67.     WrongHandler   = 20003;  (* Falsche Handlernummer ( 1 < kanal > MaxKanal) *)
  68.     WrongBaudRate  = 20100;  (* Ungültige Baudrate                            *)
  69.     WrongStopBit   = 20101;  (* Ungültige Anzahl Stopp-Bits                   *)
  70.     WrongWordLen   = 20102;  (* Ungültige Übertragungswort-Länge              *)
  71.  
  72.  
  73. (*************************************************************************)
  74.  
  75.   TYPE
  76.     LineZustand  = (On,Off);
  77.     ParityType   = (None,Even,Odd,Mark,Space);
  78.     StopBitType  = 1..2;
  79.     WordLenType  = 5..8;
  80.     BaudRateType = 75..115200;
  81.  
  82.  
  83.     SeriellBuffer = ARRAY [0..$7FFF] OF CHAR;
  84.  
  85.     SeriellDiscrType = RECORD
  86.                          PortAdresse,                      (* Basis-Adresse des 8250               *)
  87.                          PortIRQ        : WORD;            (* Interrupt-Kanal der Schnittstelle    *)
  88.                          Transmit       : BOOLEAN;         (* FALSE, wenn Empfangspuffer fast voll *)
  89.                          TransmitMask   : BYTE;            (* Maske für die Statusleitungen        *)
  90.                          BufferSize,                       (* Grösse des Empfangspuffers in Byte   *)
  91.                          BufferFull,                       (* Füll-Grenze für den Empfangspuffer   *)
  92.                          Top,                              (* erstes Zeichen im Ringpuffers        *)
  93.                          Bottom,                           (* letztes Zeichen im Ringpuffer        *)
  94.                          Anzahl         : WORD;            (* Anzahl Zeichen im Ringpuffer         *)
  95.                          Buffer         : ^SeriellBuffer;  (* Pointer auf den Ringpuffer im Heap   *)
  96.                          Install        : BOOLEAN;         (* TRUE, wenn der Handler belegt ist    *)
  97.                          PortInterrupt,                    (* Pointer auf die Interruptroutine     *)
  98.                          OldVector      : POINTER;         (* Ursprünglicher Interrupt-Vektor      *)
  99.                          LineMask,
  100.                          OldIntMask,
  101.                          OldMCR,
  102.                          OldIER         : BYTE;
  103.                          CountInt,
  104.                          CountInChar,
  105.                          CountOutChar,
  106.                          CountError,
  107.                          CountOverflow  : WORD;
  108.                          NS16550Flag    : BOOLEAN;
  109.                        END;  (* of RECORD *)
  110.  
  111.  
  112. (*************************************************************************)
  113.  
  114.   VAR
  115.     SeriellOk    : BOOLEAN;   (* TRUE, wenn kein Fehler erkannt wurde *)
  116.     SeriellError : WORD;      (* <> 0, wenn ein Fehler erkannt wurde  *)
  117.  
  118.     FiFoAktiv    : BOOLEAN;
  119.  
  120.  
  121. (*************************************************************************)
  122.  
  123. (* Einrichten eines neuen Handlers für eine serielle Schnittstelle *)
  124. (* <adr>  = Basisadresse des 8250                                  *)
  125. (* <irq>  = Interruptkanal für diesen Baustein                     *)
  126. (*          Bei Kanal 0 wird keine Interruptroutine installiert    *)
  127. (* <size> = Grösse des Empfangspuffers                             *)
  128. (*                                                                 *)
  129. (* Mit der Handlernummer <kanal> legt man bei allen Routinen fest, *)
  130. (* welche Schnittstelle angesprochen wird.                         *)
  131.  
  132. PROCEDURE InstallSeriellHandler (adr,irq,size : WORD ; VAR kanal : WORD);
  133.  
  134.  
  135. (* Den Handler eineer seriellen Schnittstelle freigeben.           *)
  136. (* Die belegten Interrupt-Vektoren werden auf ihre alten Werte     *)
  137. (* gesetzt und der Speicher auf dem Heap freigegeben.              *)
  138.  
  139. PROCEDURE DeInstallSeriellHandler (kanal : WORD);
  140.  
  141.  
  142. (* Definition des Handlers <kanal> holen.                          *)
  143.  
  144. PROCEDURE GetHandlerInfo (kanal : WORD ; VAR adr,ir,buflen : WORD);
  145.  
  146.  
  147. (* Lesen von einer seriellen Schnittstelle.                        *)
  148. (* Die Handlernummer <kanal> gibt die Schnittstelle an.            *)
  149.  
  150. FUNCTION  SeriellRead (kanal : WORD) : CHAR;
  151.  
  152.  
  153. (* Das nächste Zeichen im Buffer holen, aber nicht aus dem Buffer  *)
  154. (* entfernen                                                       *)
  155.  
  156. PROCEDURE SeriellCheckRead (kanal : WORD ; VAR zeichen : CHAR ; VAR flag : BOOLEAN);
  157.  
  158.  
  159. (* Lesen von einer seriellen Schnittstelle.                        *)
  160. (* Die Handlernummer <kanal> gibt die Schnittstelle an.            *)
  161.  
  162. PROCEDURE SeriellWrite (kanal : WORD ; zeichen : CHAR);
  163.  
  164.  
  165. (* Empfängerpuffer der Schnittstelle <kanal> leeren.               *)
  166.  
  167. PROCEDURE ClearSeriellBuffer (kanal : WORD);
  168.  
  169.  
  170. (* Testen, ob für die Schnittstelle <kanal> ein Zeichen anliegt.   *)
  171.  
  172. FUNCTION  ReceiverReady (kanal : WORD) : BOOLEAN;
  173.  
  174.  
  175. (* Testen, ob die Schnittstelle <kanal> ein Zeichen senden kann.   *)
  176.  
  177. FUNCTION  TransmitterReady (kanal : WORD) : BOOLEAN;
  178.  
  179.  
  180. (* Testen, ob CTS-Leitung der Schnittstelle <kanal> aktiv ist.     *)
  181.  
  182. FUNCTION  ClearToSend (kanal : WORD) : BOOLEAN;
  183.  
  184.  
  185. (* Testen, ob DSR-Leitung der Schnittstelle <kanal> aktiv ist.     *)
  186.  
  187. FUNCTION  DataSetReady (kanal : WORD) : BOOLEAN;
  188.  
  189.  
  190. (* Teste, ob ein Break auf der Leitung erkannt wurde               *)
  191.  
  192. FUNCTION BreakDetected (kanal : WORD) : BOOLEAN;
  193.  
  194.  
  195. (* Testen, ob CD-Leitung der Schnittstelle <kanal> aktiv ist.      *)
  196.  
  197. FUNCTION  CarrierDetector (kanal : WORD) : BOOLEAN;
  198.  
  199.  
  200. (* Setzen oder rücksetzen der DTR-Leitung.                         *)
  201.  
  202. PROCEDURE DataTerminalReady (kanal : WORD ; zustand : LineZustand);
  203.  
  204.  
  205. (* Setzen oder Rücksetzen der RTS-Leitung.                         *)
  206.  
  207. PROCEDURE RequestToSend (kanal : WORD ; zustand : LineZustand);
  208.  
  209.  
  210. (* Break-Signal ausgeben                                           *)
  211.  
  212. PROCEDURE SendBreak (kanal : WORD);
  213.  
  214.  
  215. (* Festlegen der Mask für die Auswertung der Statusleitungen der   *)
  216. (* Schnittstelle.                                                  *)
  217.  
  218. PROCEDURE SetStatusMask (kanal,mask : WORD);
  219.  
  220.  
  221. (* Festlegen der Mask für die Behandlung der Statusleitungen der   *)
  222. (* Schnittstelle wenn der Puffer voll ist.                         *)
  223. (* Zum Sperren des Senders werden die angegebenen Ausgänge auf 0   *)
  224. (* gesetzt.                                                        *)
  225.  
  226. PROCEDURE SetTransmitMask (kanal,mask : WORD);
  227.  
  228.  
  229. (* Testen, ob die Statusleitungen die mit SetStatusMask definiert  *)
  230. (* wurden, gesetzt sind.                                           *)
  231.  
  232. FUNCTION SeriellStatus (kanal : WORD) : BOOLEAN;
  233.  
  234.  
  235. (*******************************************************************)
  236.  
  237. (* Datenübertragungs-Parameter festlegen.                          *)
  238.  
  239. PROCEDURE SetParameter (kanal   : WORD;
  240.                         rate    : BaudRateType;
  241.                         parity  : ParitYType;
  242.                         stopbit : StopBitType;
  243.                         wordlen : WordLenType);
  244.  
  245.  
  246. (* Baudrate der Schnittstelle <kanal> festlegen.                   *)
  247. (* Für <baud> sind alle Werte zwischen 75 und 111500 gültig.       *)
  248.  
  249. PROCEDURE SetBaudrate (kanal : WORD ; rate : BaudRateType);
  250.  
  251.  
  252. (* Aktuelle Baudrate der Schnittstelle <kanal> ermitteln           *)
  253.  
  254. FUNCTION  GetBaudrate (kanal : WORD) : BaudRateType;
  255.  
  256.  
  257. (* Parityerzeugung und -Auswertung für die Schnittstelle <kanal>   *)
  258. (* festlegen. Zugelassen sind None,Even oder Odd                   *)
  259.  
  260. PROCEDURE SetParity (kanal : WORD ; parity : ParityType);
  261.  
  262.  
  263. (* Aktuelle Paritydefinitin der Schnittstelle <kanal< ermitteln    *)
  264.  
  265. FUNCTION  GetParity (kanal : WORD) : ParityType;
  266.  
  267.  
  268. (* Anzahl der Stopp-Bit's für die Schnittstelle <kanal> festlegen. *)
  269. (* Zugelassen sind die Werte 1 und 2.                              *)
  270.  
  271. PROCEDURE SetStopBit (kanal : WORD ; stopbit : StopBitType);
  272.  
  273.  
  274. (* Aktuelle Anzahl Stopp-Bit's für die Schnittstelle <kanal>       *)
  275. (* ermitteln                                                       *)
  276.  
  277. FUNCTION  GetStopBit (kanal : WORD) : StopBitType;
  278.  
  279.  
  280. (* Wort-Länge für die Schnittstelle <kanal> festlegen.             *)
  281. (* Mögliche Wort-Längen sind 5,6,7 und 8.                          *)
  282.  
  283. PROCEDURE SetWordLen (kanal : WORD ; wordlen : WordLenType);
  284.  
  285.  
  286. (* Aktuelle Wort-Länge der Schnittstelle <kanal> ermitteln.        *)
  287.  
  288. FUNCTION  GetWordLen (kanal : WORD) : WordLenType;
  289.  
  290.  
  291. (* Löschen der Schnittstellen-Statistik                            *)
  292.  
  293. PROCEDURE ClearHandlerStatistic (kanal : WORD);
  294.  
  295.  
  296. (* Zähler für die Anzahl Interrupts an der Schnittstelle <kanal>   *)
  297. (* einfragen.                                                      *)
  298.  
  299. FUNCTION GetIntCounter (kanal : WORD) : WORD;
  300.  
  301.  
  302. (* Zähler für die Anzahl der empfangene Zeichen an der Schnitt-     *)
  303. (* stelle <kanal> einfragen.                                        *)
  304.  
  305. FUNCTION GetReceiveCounter (kanal : WORD) : WORD;
  306.  
  307.  
  308. (* Zähler für die Anzahl gesendeten Zeichen an der Schnitt-         *)
  309. (* stelle <kanal> einfragen.                                        *)
  310.  
  311. FUNCTION GetSendCounter (kanal : WORD) : WORD;
  312.  
  313.  
  314. (* Zähler für die Anzahl der Empfangsfehler an der Schnitt-         *)
  315. (* stelle <kanal> einfragen.                                        *)
  316.  
  317. FUNCTION GetErrorCounter (kanal : WORD) : WORD;
  318.  
  319.  
  320. (* Zähler für die Anzahl der Pufferüberläufe an der Schnitt-        *)
  321. (* stelle <kanal> einfragen.                                        *)
  322.  
  323. FUNCTION GetOverflowCounter (kanal : WORD) : WORD;
  324.  
  325.  
  326. (*************************************************************************)
  327.  
  328. IMPLEMENTATION
  329.  
  330.   USES Dos;
  331.  
  332.   CONST
  333.     IntrCtrl1      = $20;    (* Basisadresse des ersten Interruptcontroler's  *)
  334.     IntrCtrl2      = $A0;    (* Basisadresse des zweiten Interruptcontroler's *)
  335.  
  336.  
  337. (*************************************************************************)
  338.  
  339.   VAR
  340.     i,
  341.     HandlerSize       : WORD;      (* Grösses eines Handler-Record's      *)
  342.  
  343.     altexitproc       : POINTER;   (* Pointer auf die alte Exit-Procedure *)
  344.  
  345.     SeriellDiscriptor : ARRAY [1..MaxKanal] OF SeriellDiscrType;
  346.  
  347.     Ticker            : LONGINT ABSOLUTE $40:$6C;
  348.  
  349.  
  350. (*************************************************************************)
  351.  
  352. {$L RS232Pas }
  353.  
  354. PROCEDURE SeriellIntrProc1; External;  (* Definition der externen Interruptroutinen *)
  355.  
  356. PROCEDURE SeriellIntrProc2; External;
  357.  
  358. PROCEDURE SeriellIntrProc3; External;
  359.  
  360. PROCEDURE SeriellIntrProc4; External;
  361.  
  362. PROCEDURE SeriellIntrProc5; External;
  363.  
  364. PROCEDURE SeriellIntrProc6; External;
  365.  
  366. PROCEDURE SeriellIntrProc7; External;
  367.  
  368. PROCEDURE SeriellIntrProc8; External;
  369.  
  370.  
  371. (*************************************************************************)
  372.  
  373.  
  374. PROCEDURE DisableInterrupt; InLine ($FA);
  375.  
  376. PROCEDURE EnableInterrupt; InLine ($FB);
  377.  
  378.  
  379. (*************************************************************************)
  380.  
  381. PROCEDURE ClearError;
  382.  
  383. BEGIN
  384.   SeriellOk:=TRUE;
  385.   SeriellError:=0;
  386. END;  (* of ClearError *)
  387.  
  388.  
  389. (*************************************************************************)
  390.  
  391. PROCEDURE SetError (err : WORD);
  392.  
  393. BEGIN
  394.   SeriellOk:=FALSE;
  395.   SeriellError:=err;
  396. END;  (* of SetErrror *)
  397.  
  398.  
  399. (*************************************************************************)
  400.  
  401. PROCEDURE InstallSeriellHandler;
  402.  
  403.   VAR
  404.     dummy : BYTE;
  405.  
  406.     wert  : WORD;
  407.  
  408. BEGIN
  409.   kanal:=1;
  410.   WHILE (SeriellDiscriptor [kanal].Install = TRUE) AND (kanal <= MaxKanal) DO INC (kanal);
  411.   IF (kanal <= MaxKanal) THEN BEGIN
  412.     wert:=PORT [adr + $06];
  413.     IF ((PORT [adr + $06] AND $0F) = 0) THEN BEGIN
  414.       WITH SeriellDiscriptor [kanal] DO BEGIN
  415.  
  416.         Transmit:=TRUE;
  417.  
  418.         Top:=0;
  419.         Bottom:=0;
  420.         Anzahl:=0;
  421.  
  422.         CountInt:=0;
  423.         CountInChar:=0;
  424.         CountOutChar:=0;
  425.         CountError:=0;
  426.         CountOverflow:=0;
  427.  
  428.         TransmitMask:=RTSOutput;
  429.  
  430.         PortAdresse:=adr;
  431.         PortIRQ:=irq;
  432.  
  433.         DisableInterrupt;
  434.  
  435.         OldIER:=PORT [PortAdresse + $01];
  436.  
  437.         adr:=PortAdresse + $04;
  438.         OldMCR:=PORT [adr];
  439.         PORT [adr]:=OldMCR AND $F7;            (* Alle Interrupts mit OUT 2 sperren  *)
  440.  
  441.         dummy:=PORT [PortAdresse + $02];
  442.         IF ((dummy AND $C0) > 0) THEN
  443.           NS16550Flag:=TRUE
  444.         ELSE BEGIN
  445.           PORT [PortAdresse + $02]:=$01;
  446.           dummy:=PORT [PortAdresse + $02];
  447.           NS16550Flag:=((dummy AND $C0) > 0);
  448.         END;  (* of ELSE *)
  449.  
  450.         IF NS16550Flag THEN BEGIN
  451.           IF FiFoAktiv THEN
  452.             PORT [PortAdresse + $02]:=$E1
  453.           ELSE PORT [PortAdresse + $02]:=0;
  454.         END;  (* of IF *)
  455.  
  456.         dummy:=PORT [PortAdresse];
  457.         dummy:=PORT [PortAdresse + $05];       (* Leitungsstatus-Register löschen    *)
  458.  
  459.         IF (PortIRQ <> 0) THEN BEGIN           (* Empfangsintr. nur bei IRQ <> 0 installieren *)
  460.  
  461.           IF (size > $7FFF) THEN size:=$7FFF;  (* Buffersize max. $7FFF            *)
  462.           IF (MaxAvail < size) THEN            (* wenn zuwenig Platz auf dem Heap, *)
  463.             BufferSize:=MaxAvail               (* dann wird der Buffer verkleinert *)
  464.           ELSE BufferSize:=size;
  465.  
  466.           GetMem (Buffer,BufferSize);          (* Speicher für den Empfangsbuffer reservieren *)
  467.  
  468.           BufferFull:=WORD (LONGINT (BufferSize) * 90 DIV 100);
  469.           IF (BufferFull < 10) THEN BufferFull:=10;
  470.  
  471.           PORT [PortAdresse + $01]:=$01;       (* Interrupt bei Empfang zulassen    *)
  472.  
  473.           adr:=PortAdresse + $04;
  474.           wert:=PORT [adr];
  475.           PORT [adr]:=wert OR TransmitMask OR $08;          (* Die Steuerleitungen setzen        *)
  476.  
  477.           IF (PortIRQ < 8) THEN BEGIN                        (* IRQ0 - IRQ7: erster 8259   *)
  478.             GetIntVec ($08 + PortIRQ,OldVector);             (* Interrupt-Vektor retten    *)
  479.             SetIntVec ($08 + PortIRQ,PortInterrupt);         (* und neu setzen             *)
  480.  
  481.             adr:=IntrCtrl1 + $01;
  482.             OldIntMask:=PORT [adr];
  483.             PORT [adr]:=OldIntMask AND ($FF XOR 1 SHL PortIRQ);
  484.             OldIntMask:=OldIntMask AND (1 SHL PortIRQ);
  485.           END  (* of IF THEN *)
  486.           ELSE BEGIN                                         (* IRQ8 - IRQ15: zweiter 8259 *)
  487.             GetIntVec ($70 + (PortIRQ - 8),OldVector);       (* Interrupt-Vektor retten    *)
  488.             SetIntVec ($70 + (PortIRQ - 8),PortInterrupt);   (* und neu setzen             *)
  489.  
  490.             adr:=IntrCtrl2 + $01;
  491.             OldIntMask:=PORT [adr];
  492.             PORT [adr]:=OldIntMask AND ($FF XOR 1 SHL (PortIRQ - 8));
  493.             OldIntMask:=OldIntMask AND (1 SHL (PortIRQ - 8));
  494.           END;  (* of ELSE *)
  495.         END  (* of IF THEN *)
  496.         ELSE BEGIN
  497.           Buffer:=NIL;                        (* Ohne Interrupt auch kein Puffer      *)
  498.           OldIntMask:=$00;
  499.         END;  (* of ELSE *)
  500.  
  501.         dummy:=PORT [PortAdresse];
  502.         dummy:=PORT [PortAdresse + $05];       (* Leitungsstatus-Register löschen    *)
  503.  
  504.         EnableInterrupt;
  505.  
  506.         Install:=TRUE;                         (* Handler als belegt kennzeichenen     *)
  507.         ClearError;
  508.       END;  (* of WITH *)
  509.     END  (* of IF THEN *)
  510.     ELSE BEGIN
  511.       kanal:=0;
  512.       SetError (NoChip);
  513.     END;  (* of ELSE *)
  514.   END  (* of IF THEN *)
  515.   ELSE BEGIN
  516.     kanal:=0;                                  (* kanal = 0 wenn kein Handler frei ist *)
  517.     SetError (NoHandler);
  518.   END;  (* of ELSE *)
  519. END;  (* of InstallSeriellHandler *)
  520.  
  521.  
  522. (*************************************************************************)
  523.  
  524. PROCEDURE DeInstallSeriellHandler;
  525.  
  526.   VAR
  527.     adr : WORD;
  528.  
  529. BEGIN
  530.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN          (* Nur gültige Handler bearbeiten     *)
  531.     WITH SeriellDiscriptor [kanal] DO BEGIN
  532.       IF Install THEN BEGIN
  533.         IF (Buffer <> NIL) THEN BEGIN                        (* Wenn ein Empfangspuffer angelegt   *)
  534.           FreeMem (Buffer,BufferSize);                       (* wurde, wird dieser vom Heap        *)
  535.           Buffer:=NIL;                                       (* entfernt.                          *)
  536.         END;  (* of IF *)
  537.  
  538.         DisableInterrupt;
  539.  
  540.         PORT [PortAdresse + $01]:=OldIER;                       (* alle Interrupts des 8250 sperren   *)
  541.  
  542.         PORT [PortAdresse + $04]:=OldMCR;
  543.  
  544.         IF (PortIRQ <> 0) THEN BEGIN                         (* Interrupt am 8259 sperren und den  *)
  545.           IF (PortIRQ < 8) THEN BEGIN                        (* die Vektor-Adresse restaureien.    *)
  546.             adr:=IntrCtrl1 + $01;
  547.             PORT [adr]:=PORT [adr] OR OldIntMask;
  548.             SetIntVec ($08 + PortIRQ,OldVector);
  549.           END  (* of IF *)
  550.           ELSE BEGIN
  551.             adr:=IntrCtrl2 + $01;
  552.             PORT [adr]:=PORT [adr] OR OldIntMask;
  553.             SetIntVec ($70 + (PortIRQ - 8),OldVector);
  554.           END;  (* of ELSE *)
  555.         END;  (* of IF *)
  556.  
  557.         EnableInterrupt;
  558.  
  559.         Install:=FALSE;                        (* Handler freigeben                  *)
  560.       END  (* of IF *)
  561.       ELSE SetError (NotInstall);
  562.     END;  (* of WITH *)
  563.   END  (* of IF *)
  564.   ELSE SetError (WrongHandler);
  565. END;  (* of DeInstallSeriellHandler *)
  566.  
  567.  
  568. (*************************************************************************)
  569.  
  570. PROCEDURE GetHandlerInfo;
  571.  
  572. BEGIN
  573.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN          (* Nur gültige Handler bearbeiten     *)
  574.     WITH SeriellDiscriptor [kanal] DO BEGIN
  575.       IF Install THEN BEGIN
  576.         adr:=PortAdresse;
  577.         ir:=PortIRQ;
  578.         buflen:=BufferSize;
  579.       END  (* of IF *)
  580.       ELSE SetError (NotInstall);
  581.     END;  (* of WITH *)
  582.   END  (* of IF *)
  583.   ELSE SetError (WrongHandler);
  584. END;  (* of GetHandlerInfo *)
  585.  
  586.  
  587. (*************************************************************************)
  588.  
  589. (* Lesen eines Zeichens vom seriellen Kanal <kanal> *)
  590.  
  591. FUNCTION SeriellRead; External;
  592.  
  593.  
  594. (*************************************************************************)
  595.  
  596. (* Lesen eines Zeichens vom seriellen Kanal <kanal> *)
  597.  
  598. PROCEDURE SeriellCheckRead;
  599.  
  600. BEGIN
  601.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  602.     WITH SeriellDiscriptor [kanal] DO BEGIN
  603.       IF Install THEN BEGIN
  604.         IF (Anzahl > 0) THEN BEGIN
  605.           zeichen:=Buffer^[Bottom];                (* Zeichen aus dem Puffer holen und     *)
  606.           flag:=TRUE;
  607.         END  (* of IF *)
  608.         ELSE flag:=FALSE;
  609.  
  610.         ClearError;
  611.       END  (* of IF THEN *)
  612.       ELSE SetError (NotInstall);
  613.     END;  (* of WITH *)
  614.   END  (* of IF THEN *)
  615.   ELSE SetError (WrongHandler);
  616. END;  (* of SeriellCheckRead *)
  617.  
  618.  
  619. (*************************************************************************)
  620.  
  621. PROCEDURE SeriellWrite; External;
  622.  
  623.  
  624. (*************************************************************************)
  625.  
  626. PROCEDURE ClearSeriellBuffer;
  627.  
  628.   VAR
  629.     adr : WORD;
  630.  
  631. BEGIN
  632.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  633.     WITH SeriellDiscriptor [kanal] DO BEGIN
  634.       IF Install THEN BEGIN
  635.         DisableInterrupt;
  636.  
  637.         Anzahl:=0;
  638.         Top:=0;
  639.         Bottom:=0;
  640.  
  641.         IF NOT (Transmit) THEN BEGIN                       (* Wenn der Puffer fast voll war,       *)
  642.           IF (Anzahl < (BufferSize - $10)) THEN BEGIN      (* teste, ob wieder Platz vorhanden ist *)
  643.             adr:=PortAdresse + $04;
  644.             Port [adr]:=Port [adr] OR TransmitMask;        (* Wenn ja, Steuerleitungen setzen und  *)
  645.             Transmit:=TRUE;                                (* das Flag für "Puffer voll" löschen.  *)
  646.           END;  (* of IF *)
  647.         END;  (* of IF *)
  648.  
  649.         EnableInterrupt;
  650.  
  651.         ClearError;
  652.       END  (* of IF *)
  653.       ELSE SetError (NotInstall);
  654.     END;  (* of WITH *)
  655.   END  (* of IF THEN *)
  656.   ELSE SetError (WrongHandler);
  657. END;  (* of ClearSeriellBuffer *)
  658.  
  659.  
  660. (*************************************************************************)
  661.  
  662. FUNCTION ReceiverReady; External;
  663.  
  664.  
  665. (*************************************************************************)
  666.  
  667. FUNCTION TransmitterReady;
  668.  
  669. BEGIN
  670.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  671.     WITH SeriellDiscriptor [kanal] DO BEGIN
  672.       IF Install THEN BEGIN
  673.         TransmitterReady:=((Port [PortAdresse + $05] AND $20) > 0);
  674.       END  (* of IF *)
  675.       ELSE TransmitterReady:=FALSE;
  676.     END;  (* of WITH *)
  677.     ClearError;
  678.   END  (* of IF THEN *)
  679.   ELSE BEGIN
  680.     TransmitterReady:=FALSE;
  681.     SetError (WrongHandler);
  682.   END;  (* of ELSE *)
  683. END;  (* of TransmitterReady *)
  684.  
  685.  
  686. (*************************************************************************)
  687.  
  688. FUNCTION ClearToSend;
  689.  
  690. BEGIN
  691.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  692.     WITH SeriellDiscriptor [kanal] DO BEGIN
  693.       IF Install THEN BEGIN
  694.         ClearToSend:=((Port [PortAdresse + $06] AND $10) > 0);
  695.       END  (* of IF *)
  696.       ELSE ClearToSend:=FALSE;
  697.     END;  (* of WITH *)
  698.     ClearError;
  699.   END  (* of IF *)
  700.   ELSE BEGIN
  701.     ClearToSend:=FALSE;
  702.     SetError (WrongHandler);
  703.   END;  (* of ELSE *)
  704. END;  (* of ClearToSend *)
  705.  
  706.  
  707. (*************************************************************************)
  708.  
  709. FUNCTION DataSetReady;
  710.  
  711. BEGIN
  712.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  713.     WITH SeriellDiscriptor [kanal] DO BEGIN
  714.       IF Install THEN BEGIN
  715.         DataSetReady:=((Port [PortAdresse + $06] AND $20) > 0);
  716.       END  (* of IF *)
  717.       ELSE DataSetReady:=FALSE;
  718.     END;  (* of WITH *)
  719.     ClearError;
  720.   END  (* of IF *)
  721.   ELSE BEGIN
  722.     DataSetReady:=FALSE;
  723.     SetError (WrongHandler);
  724.   END;  (* of ELSE *)
  725. END;  (* of DataSetReady *)
  726.  
  727.  
  728. (*************************************************************************)
  729.  
  730. FUNCTION CarrierDetector;
  731.  
  732. BEGIN
  733.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  734.     WITH SeriellDiscriptor [kanal] DO BEGIN
  735.       IF Install THEN BEGIN
  736.         CarrierDetector:=((Port [PortAdresse + $06] AND $80) > 0);
  737.       END  (* of IF *)
  738.       ELSE CarrierDetector:=FALSE;
  739.     END;  (* of WITH *)
  740.     ClearError;
  741.   END  (* of IF *)
  742.   ELSE BEGIN
  743.     CarrierDetector:=FALSE;
  744.     SetError (WrongHandler);
  745.   END;  (* of ELSE *)
  746. END;  (* of CarrierDetector *)
  747.  
  748.  
  749. (*************************************************************************)
  750.  
  751. FUNCTION BreakDetected;
  752.  
  753.   VAR
  754.     adresse : WORD;
  755.  
  756.     break   : BOOLEAN;
  757.  
  758. BEGIN
  759.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  760.     WITH SeriellDiscriptor [kanal] DO BEGIN
  761.       IF Install THEN BEGIN
  762.         adresse:=PortAdresse + $05;
  763.         break:=((Port [adresse] AND $08) > 0);
  764.         IF break THEN Port [adresse]:=Port [adresse] AND $F7;
  765.         BreakDetected:=break;
  766.       END  (* of IF *)
  767.       ELSE BreakDetected:=FALSE;
  768.     END;  (* of WITH *)
  769.     ClearError;
  770.   END  (* of IF *)
  771.   ELSE BEGIN
  772.     BreakDetected:=FALSE;
  773.     SetError (WrongHandler);
  774.   END;  (* of ELSE *)
  775. END;  (* of BreakDetected *)
  776.  
  777.  
  778. (*************************************************************************)
  779.  
  780. PROCEDURE DataTerminalReady;
  781.  
  782.   VAR
  783.     wert,
  784.     adr   : WORD;
  785.  
  786. BEGIN
  787.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  788.     WITH SeriellDiscriptor [kanal] DO BEGIN
  789.       IF Install THEN BEGIN
  790.         adr:=PortAdresse + $04;
  791.         wert:=PORT [adr];
  792.         IF (zustand = On) THEN
  793.           wert:=wert OR $01
  794.         ELSE wert:=wert AND $FE;
  795.         PORT [adr]:=wert;
  796.         ClearError;
  797.       END  (* of IF THEN *)
  798.       ELSE SetError (NotInstall);
  799.     END;  (* of WITH *)
  800.   END  (* of IF *)
  801.   ELSE SetError (WrongHandler);
  802. END;  (* of DataTerminalReady *)
  803.  
  804.  
  805. (*************************************************************************)
  806.  
  807. PROCEDURE RequestToSend;
  808.  
  809.   VAR
  810.     wert,
  811.     adr   : WORD;
  812.  
  813. BEGIN
  814.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  815.     WITH SeriellDiscriptor [kanal] DO BEGIN
  816.       IF Install THEN BEGIN
  817.         adr:=PortAdresse + $04;
  818.         wert:=PORT [adr];
  819.         IF (zustand = On) THEN
  820.           wert:=wert OR $02
  821.         ELSE wert:=wert AND $FD;
  822.         PORT [adr]:=wert;
  823.         ClearError;
  824.       END  (* of IF THEN *)
  825.       ELSE SetError (NotInstall);
  826.     END;  (* of WITH *)
  827.   END  (* of IF *)
  828.   ELSE SetError (WrongHandler);
  829. END;  (* of RequestToSend *)
  830.  
  831.  
  832. (*************************************************************************)
  833.  
  834. PROCEDURE SendBreak;
  835.  
  836.   VAR
  837.     breaktime : LONGINT;
  838.  
  839.     teiler,
  840.     adr       : WORD;
  841.  
  842. BEGIN
  843.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  844.     WITH SeriellDiscriptor [kanal] DO BEGIN
  845.       IF Install THEN BEGIN
  846.         adr:=PortAdresse + $03;
  847.         DisableInterrupt;
  848.         PORT [adr]:=PORT [adr] OR $80;
  849.         teiler:=PortW [PortAdresse];
  850.         PORT [adr]:=PORT [adr] AND $7F;
  851.         EnableInterrupt;
  852.         breaktime:=teiler DIV 200;
  853.         IF (breaktime < 1) THEN breaktime:=1;
  854.         breaktime:=Ticker + breaktime;
  855.         Port [adr]:=Port [adr] OR $40;
  856.         REPEAT
  857.         UNTIL (Ticker > breaktime);
  858.         Port [adr]:=Port [adr] AND $BF;
  859.         ClearError;
  860.       END  (* of IF THEN *)
  861.       ELSE SetError (NotInstall);
  862.     END;  (* of WITH *)
  863.   END  (* of IF *)
  864.   ELSE SetError (WrongHandler);
  865. END;  (* of SendBreak *)
  866.  
  867.  
  868. (*************************************************************************)
  869.  
  870. PROCEDURE SetStatusMask;
  871.  
  872. BEGIN
  873.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  874.     SeriellDiscriptor [kanal].LineMask:=(mask MOD $FF);
  875.     ClearError;
  876.   END  (* of IF THEN *)
  877.   ELSE SetError (WrongHandler);
  878. END;  (* of SetStatusMask *)
  879.  
  880.  
  881. (*************************************************************************)
  882.  
  883. PROCEDURE SetTransmitMask;
  884.  
  885. BEGIN
  886.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  887.     SeriellDiscriptor [kanal].TransmitMask:=(mask MOD $FF);
  888.     ClearError;
  889.   END  (* of IF THEN *)
  890.   ELSE SetError (WrongHandler);
  891. END;  (* of SetTransmitMask *)
  892.  
  893.  
  894. (*************************************************************************)
  895.  
  896. FUNCTION SeriellStatus;
  897.  
  898.   VAR
  899.     status : WORD;
  900.  
  901. BEGIN
  902.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  903.     WITH SeriellDiscriptor [kanal] DO BEGIN
  904.       IF Install THEN BEGIN
  905.         IF ((Port [PortAdresse + $05] AND $20) > 0) THEN
  906.           SeriellStatus:=((Port [PortAdresse + $06] AND LineMask) = LineMask)
  907.         ELSE SeriellStatus:=FALSE;
  908.         ClearError;
  909.       END  (* of IF *)
  910.       ELSE BEGIN
  911.         SeriellStatus:=FALSE;
  912.         SetError (NotInstall);
  913.       END;  (* of ELSE *)
  914.     END;  (* of WITH *)
  915.   END  (* of IF *)
  916.   ELSE BEGIN
  917.     SeriellStatus:=FALSE;
  918.     SetError (WrongHandler);
  919.   END;  (* of ELSE *)
  920. END;  (* of SeriellStatus *)
  921.  
  922.  
  923. (*************************************************************************)
  924.  
  925. (* Vor Beendigung des Programmes werden alle noch installierten Handler *)
  926. (* freigegeben.                                                         *)
  927.  
  928. {$F+}
  929. PROCEDURE SeriellInterfaceExit;
  930. {$F-}
  931.  
  932.    VAR
  933.      adr : WORD;
  934.  
  935. BEGIN
  936.   FOR i:=1 TO MaxKanal DO BEGIN
  937.     WITH SeriellDiscriptor [i] DO BEGIN
  938.       IF Install THEN BEGIN
  939.  
  940.         IF (Buffer <> NIL) THEN BEGIN                        (* Wenn ein Empfangspuffer angelegt   *)
  941.           FreeMem (Buffer,BufferSize);                       (* wurde, wird dieser vom Heap        *)
  942.           Buffer:=NIL;                                       (* entfernt.                          *)
  943.         END;  (* of IF *)
  944.  
  945.         DisableInterrupt;
  946.  
  947.         PORT [PortAdresse + $01]:=OldIER;                       (* alle Interrupts des 8250 sperren   *)
  948.  
  949.         PORT [PortAdresse + $04]:=OldMCR;
  950.  
  951.         IF (PortIRQ <> 0) THEN BEGIN                         (* Interrupt am 8259 sperren und den  *)
  952.           IF (PortIRQ < 8) THEN BEGIN                        (* die Vektor-Adresse restaureien.    *)
  953.             adr:=IntrCtrl1 + $01;
  954.             PORT [adr]:=PORT [adr] OR OldIntMask;
  955.             SetIntVec ($08 + PortIRQ,OldVector);
  956.           END  (* of IF *)
  957.           ELSE BEGIN
  958.             adr:=IntrCtrl2 + $01;
  959.             PORT [adr]:=PORT [adr] OR OldIntMask;
  960.             SetIntVec ($70 + (PortIRQ - 8),OldVector);
  961.           END;  (* of ELSE *)
  962.         END;  (* of IF *)
  963.  
  964.         EnableInterrupt;
  965.  
  966.         Install:=FALSE;                        (* Handler freigeben                  *)
  967.       END;  (* of IF *)
  968.     END;  (* of WITH *)
  969.   END;  (* of FOR *)
  970.  
  971.   ExitProc:=altexitproc;
  972. END;  (* of SeriellInterfaceExit *)
  973.  
  974.  
  975. (*************************************************************************)
  976.  
  977. (* Programmieren der seriellen Übertragungsparameter. *)
  978.  
  979. PROCEDURE SetParameter;
  980.  
  981.   VAR
  982.     basisadr,
  983.     wert      : WORD;
  984.  
  985. BEGIN
  986.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  987.     WITH SeriellDiscriptor [kanal] DO BEGIN
  988.       IF Install THEN BEGIN
  989.         DisableInterrupt;
  990.         basisadr:=PortAdresse;
  991.  
  992.         PORT[basisadr + 3]:=$80;
  993.         wert:=WORD (115200 DIV rate);
  994.         PORTW [basisadr]:=wert;
  995.  
  996.         wert:=0;
  997.  
  998.         CASE Parity OF
  999.            Even : wert:=wert OR $18;
  1000.             Odd : wert:=wert OR $08;
  1001.            Mark : wert:=wert OR $28;
  1002.           Space : wert:=wert OR $38;
  1003.         END;  (* of CASE *)
  1004.  
  1005.         IF (stopbit = 2) THEN wert:=wert OR $04;
  1006.  
  1007.         wert:=wert + (wordlen - 5);
  1008.  
  1009.         Port [basisadr + $03]:=wert;
  1010.  
  1011.         wert:=Port [basisadr + $05];
  1012.         EnableInterrupt;
  1013.         ClearError;
  1014.       END  (* of IF THEN *)
  1015.       ELSE SetError (NotInstall);
  1016.     END;  (* of WITH *)
  1017.   END  (* of IF *)
  1018.   ELSE SetError (WrongHandler);
  1019. END;  (* of SetParameter *)
  1020.  
  1021.  
  1022. (*************************************************************************)
  1023.  
  1024. (* Programmieren der Baudrate <rate> der ser. Schnittstelle an  *)
  1025. (* der Basisadresse <basisadr>                                  *)
  1026.  
  1027. PROCEDURE SetBaudrate;
  1028.  
  1029.   VAR
  1030.     basisadr,
  1031.     wert      : WORD;
  1032.  
  1033. BEGIN
  1034.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1035.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1036.       IF Install THEN BEGIN
  1037.         DisableInterrupt;
  1038.         basisadr:=PortAdresse;
  1039.         PORT[basisadr + 3]:=PORT[basisadr + 3] OR $80;
  1040.         wert:=WORD (115200 DIV rate);
  1041.         PORTW [basisadr]:=wert;
  1042.         PORT[basisadr + 3]:=PORT[basisadr + 3] AND $7F;
  1043.         wert:=Port [basisadr + $05];
  1044.         ClearError;
  1045.         EnableInterrupt;
  1046.       END  (* of IF THEN *)
  1047.       ELSE SetError (NotInstall);
  1048.     END;  (* of WITH *)
  1049.   END  (* of IF *)
  1050.   ELSE SetError (WrongHandler);
  1051. END;  (* of SetBaudrate *)
  1052.  
  1053.  
  1054. (*************************************************************************)
  1055.  
  1056. (* Ermitteln der Baudrate der ser. Schnittstelle an *)
  1057. (* der Basisdadresse <basisadr>.                    *)
  1058.  
  1059. FUNCTION GetBaudrate;
  1060.  
  1061.   VAR
  1062.     teiler,
  1063.     basisadr,
  1064.     wert      : WORD;
  1065.  
  1066. BEGIN
  1067.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1068.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1069.       IF Install THEN BEGIN
  1070.         basisadr:=PortAdresse;
  1071.         DisableInterrupt;
  1072.         PORT [basisadr + 3]:=PORT [basisadr + 3] OR $80;
  1073.         teiler:=PORTW[basisadr];
  1074.         PORT [basisadr + 3]:=PORT [basisadr + 3] AND $7F;
  1075.         EnableInterrupt;
  1076.         IF (teiler <> 0) THEN
  1077.           GetBaudrate:=LONGINT (115200 DIV teiler)
  1078.         ELSE GetBaudrate:=75;
  1079.         ClearError;
  1080.       END  (* of IF *)
  1081.       ELSE BEGIN
  1082.         GetBaudrate:=75;
  1083.         SetError (NotInstall);
  1084.       END;  (* of ELSE *)
  1085.     END;  (* of WITH *)
  1086.   END  (* of IF *)
  1087.   ELSE BEGIN
  1088.     GetBaudrate:=75;
  1089.     SetError (WrongHandler);
  1090.   END;  (* of ELSE *)
  1091. END;  (* of GetBaudrate *)
  1092.  
  1093.  
  1094. (*************************************************************************)
  1095.  
  1096. PROCEDURE SetParity;
  1097.  
  1098.   VAR
  1099.     basisadr,
  1100.     wert      : WORD;
  1101.  
  1102. BEGIN
  1103.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1104.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1105.       IF Install THEN BEGIN
  1106.         basisadr:=PortAdresse;
  1107.         DisableInterrupt;
  1108.         wert:=Port [basisadr + $03];
  1109.  
  1110.         wert:=wert AND $C7;
  1111.  
  1112.         CASE Parity OF
  1113.            Even : wert:=wert OR $18;
  1114.             Odd : wert:=wert OR $08;
  1115.            Mark : wert:=wert OR $28;
  1116.           Space : wert:=wert OR $38;
  1117.         END;  (* of CASE *)
  1118.  
  1119.         Port [basisadr + $03]:=wert;
  1120.  
  1121.         wert:=Port [basisadr + $05];
  1122.         EnableInterrupt;
  1123.       END  (* of IF *)
  1124.       ELSE SetError (NotInstall);
  1125.     END;  (* of WITH *)
  1126.   END  (* of IF *)
  1127.   ELSE SetError (WrongHandler);
  1128. END;  (* of SetParity *)
  1129.  
  1130.  
  1131. (*************************************************************************)
  1132.  
  1133. FUNCTION GetParity;
  1134.  
  1135.   VAR
  1136.     basisadr,
  1137.     wert      : WORD;
  1138.  
  1139. BEGIN
  1140.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1141.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1142.       IF Install THEN BEGIN
  1143.         basisadr:=PortAdresse;
  1144.         wert:=Port [basisadr + $03] AND $38;
  1145.         IF ((wert AND $08) > 0) THEN BEGIN
  1146.           wert:=wert SHR 4;
  1147.           CASE wert OF
  1148.             0 : GetParity:=Odd;
  1149.             1 : GetParity:=Even;
  1150.             2 : GetParity:=Mark;
  1151.             3 : GetParity:=Space;
  1152.           END;  (* of CASE *)
  1153.         END  (* of IF THEN *)
  1154.         ELSE GetParity:=None;
  1155.       END  (* of IF *)
  1156.       ELSE BEGIN
  1157.         GetParity:=None;
  1158.         SetError (NotInstall);
  1159.       END;  (* of ELSE *)
  1160.     END;  (* of WITH *)
  1161.   END  (* of IF *)
  1162.   ELSE BEGIN
  1163.     GetParity:=None;
  1164.     SetError (WrongHandler);
  1165.   END;  (* of ELSE *)
  1166. END;  (* of GetParity *)
  1167.  
  1168.  
  1169. (*************************************************************************)
  1170.  
  1171. PROCEDURE SetStopBit;
  1172.  
  1173.   VAR
  1174.     basisadr,
  1175.     wert      : WORD;
  1176.  
  1177. BEGIN
  1178.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1179.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1180.       IF Install THEN BEGIN
  1181.         basisadr:=PortAdresse;
  1182.         DisableInterrupt;
  1183.         wert:=Port [basisadr + $03];
  1184.         IF (stopbit = 2) THEN
  1185.           wert:=wert OR $04
  1186.         ELSE wert:=wert AND $FB;
  1187.         Port [basisadr + $03]:=wert;
  1188.         wert:=Port [basisadr + $05];
  1189.         EnableInterrupt;
  1190.       END  (* of IF THEN *)
  1191.       ELSE SetError (NotInstall);
  1192.     END;  (* of WITH *)
  1193.   END  (* of IF THEN *)
  1194.   ELSE SetError (WrongHandler);
  1195. END;  (* of SetStopBit *)
  1196.  
  1197. (*************************************************************************)
  1198.  
  1199. FUNCTION GetStopBit;
  1200.  
  1201.   VAR
  1202.     basisadr,
  1203.     wert      : WORD;
  1204.  
  1205. BEGIN
  1206.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1207.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1208.       IF Install THEN BEGIN
  1209.         basisadr:=PortAdresse;
  1210.         wert:=Port [basisadr + $03];
  1211.         IF ((wert AND $04) > 0) THEN
  1212.           GetStopBit:=2
  1213.         ELSE GetStopBit:=1;
  1214.       END  (* of IF *)
  1215.       ELSE BEGIN
  1216.         GetStopBit:=1;
  1217.         SetError (NotInstall);
  1218.       END;  (* of ELSE *)
  1219.     END;  (* of WITH *)
  1220.   END  (* of IF THEN *)
  1221.   ELSE BEGIN
  1222.     GetStopBit:=1;
  1223.     SetError (WrongHandler);
  1224.   END;  (* of ELSE *)
  1225. END;  (* of GetStopBit *)
  1226.  
  1227.  
  1228. (*************************************************************************)
  1229.  
  1230. PROCEDURE SetWordLen;
  1231.  
  1232.   VAR
  1233.     basisadr,
  1234.     wert      : WORD;
  1235.  
  1236. BEGIN
  1237.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1238.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1239.       IF Install THEN BEGIN
  1240.         basisadr:=PortAdresse;
  1241.         DisableInterrupt;
  1242.         wert:=Port [basisadr + $03];
  1243.         wert:=wert AND $FC;
  1244.         wert:=wert + (wordlen - 5);
  1245.         Port [basisadr + $03]:=wert;
  1246.         wert:=Port [basisadr + $05];
  1247.         EnableInterrupt;
  1248.       END  (* of IF THEN *)
  1249.       ELSE SetError (NotInstall);
  1250.     END;  (* of WITH *)
  1251.   END  (* of IF *)
  1252.   ELSE SetError (WrongHandler);
  1253. END;  (* of SetWordLen *)
  1254.  
  1255. (*************************************************************************)
  1256.  
  1257. FUNCTION GetWordLen;
  1258.  
  1259.   VAR
  1260.     basisadr,
  1261.     wert      : WORD;
  1262.  
  1263. BEGIN
  1264.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1265.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1266.       IF Install THEN BEGIN
  1267.         basisadr:=PortAdresse;
  1268.         wert:=Port [basisadr + $03];
  1269.         GetWordLen:=(wert AND $03) + 5;
  1270.       END  (* of IF THEN *)
  1271.       ELSE BEGIN
  1272.         GetWordLen:=5;
  1273.         SetError (NotInstall);
  1274.       END;  (* of IF *)
  1275.     END;  (* of WITH *)
  1276.   END  (* of IF THEN *)
  1277.   ELSE BEGIN
  1278.     GetWordLen:=5;
  1279.     SetError (WrongHandler);
  1280.   END;  (* of ELSE *)
  1281. END;  (* of GetWordLen *)
  1282.  
  1283.  
  1284. (*************************************************************************)
  1285.  
  1286. PROCEDURE ClearHandlerStatistic;
  1287.  
  1288. BEGIN
  1289.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1290.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1291.       IF Install THEN BEGIN
  1292.         CountInt:=0;
  1293.         CountInChar:=0;
  1294.         CountOutChar:=0;
  1295.         CountError:=0;
  1296.         CountOverflow:=0;
  1297.         ClearError;
  1298.       END  (* of IF THEN *)
  1299.       ELSE SetError (NotInstall);
  1300.     END;  (* of WITH *)
  1301.   END  (* of IF *)
  1302.   ELSE SetError (WrongHandler);
  1303. END;  (* of SetWordLen *)
  1304.  
  1305.  
  1306. (*************************************************************************)
  1307.  
  1308. FUNCTION GetIntCounter;
  1309.  
  1310. BEGIN
  1311.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1312.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1313.       IF Install THEN BEGIN
  1314.         GetIntCounter:=CountInt;
  1315.         ClearError;
  1316.       END  (* of IF THEN *)
  1317.       ELSE BEGIN
  1318.         GetIntCounter:=0;
  1319.         SetError (NotInstall);
  1320.       END;  (* of IF *)
  1321.     END;  (* of WITH *)
  1322.   END  (* of IF THEN *)
  1323.   ELSE BEGIN
  1324.     GetIntCounter:=0;
  1325.     SetError (WrongHandler);
  1326.   END;  (* of ELSE *)
  1327. END;  (* of GetIntCounter *)
  1328.  
  1329.  
  1330. (*************************************************************************)
  1331.  
  1332. FUNCTION GetReceiveCounter;
  1333.  
  1334. BEGIN
  1335.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1336.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1337.       IF Install THEN BEGIN
  1338.         GetReceiveCounter:=CountInChar;
  1339.         ClearError;
  1340.       END  (* of IF THEN *)
  1341.       ELSE BEGIN
  1342.         GetReceiveCounter:=0;
  1343.         SetError (NotInstall);
  1344.       END;  (* of IF *)
  1345.     END;  (* of WITH *)
  1346.   END  (* of IF THEN *)
  1347.   ELSE BEGIN
  1348.     GetReceiveCounter:=0;
  1349.     SetError (WrongHandler);
  1350.   END;  (* of ELSE *)
  1351. END;  (* of GetReceiveCounter *)
  1352.  
  1353.  
  1354. (*************************************************************************)
  1355.  
  1356. FUNCTION GetSendCounter;
  1357.  
  1358. BEGIN
  1359.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1360.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1361.       IF Install THEN BEGIN
  1362.         GetSendCounter:=CountOutChar;
  1363.         ClearError;
  1364.       END  (* of IF THEN *)
  1365.       ELSE BEGIN
  1366.         GetSendCounter:=0;
  1367.         SetError (NotInstall);
  1368.       END;  (* of IF *)
  1369.     END;  (* of WITH *)
  1370.   END  (* of IF THEN *)
  1371.   ELSE BEGIN
  1372.     GetSendCounter:=0;
  1373.     SetError (WrongHandler);
  1374.   END;  (* of ELSE *)
  1375. END;  (* of GetSendCounter *)
  1376.  
  1377.  
  1378. (*************************************************************************)
  1379.  
  1380. FUNCTION GetErrorCounter;
  1381.  
  1382. BEGIN
  1383.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1384.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1385.       IF Install THEN BEGIN
  1386.         GetErrorCounter:=CountError;
  1387.         ClearError;
  1388.       END  (* of IF THEN *)
  1389.       ELSE BEGIN
  1390.         GetErrorCounter:=0;
  1391.         SetError (NotInstall);
  1392.       END;  (* of IF *)
  1393.     END;  (* of WITH *)
  1394.   END  (* of IF THEN *)
  1395.   ELSE BEGIN
  1396.     GetErrorCounter:=0;
  1397.     SetError (WrongHandler);
  1398.   END;  (* of ELSE *)
  1399. END;  (* of GetErrorCounter *)
  1400.  
  1401.  
  1402. (*************************************************************************)
  1403.  
  1404. FUNCTION GetOverflowCounter;
  1405.  
  1406. BEGIN
  1407.   IF (kanal > 0) AND (kanal <= MaxKanal) THEN BEGIN
  1408.     WITH SeriellDiscriptor [kanal] DO BEGIN
  1409.       IF Install THEN BEGIN
  1410.         GetOverflowCounter:=CountOverflow;
  1411.         ClearError;
  1412.       END  (* of IF THEN *)
  1413.       ELSE BEGIN
  1414.         GetOverflowCounter:=0;
  1415.         SetError (NotInstall);
  1416.       END;  (* of IF *)
  1417.     END;  (* of WITH *)
  1418.   END  (* of IF THEN *)
  1419.   ELSE BEGIN
  1420.     GetOverflowCounter:=0;
  1421.     SetError (WrongHandler);
  1422.   END;  (* of ELSE *)
  1423. END;  (* of GetOverflowCounter *)
  1424.  
  1425.  
  1426. (*************************************************************************)
  1427.  
  1428. BEGIN
  1429.   HandlerSize:=SizeOf (SeriellDiscrType);
  1430.  
  1431.   FOR i:=1 TO MaxKanal DO BEGIN
  1432.     WITH SeriellDiscriptor [i] DO BEGIN
  1433.       Install:=FALSE;
  1434.       Buffer:=NIL;
  1435.       OldVector:=NIL;
  1436.     END;  (* of WITH *)
  1437.   END;  (* of FOR *)
  1438.  
  1439.   SeriellDiscriptor [1].PortInterrupt:=@SeriellIntrProc1;
  1440.   SeriellDiscriptor [2].PortInterrupt:=@SeriellIntrProc2;
  1441.   SeriellDiscriptor [3].PortInterrupt:=@SeriellIntrProc3;
  1442.   SeriellDiscriptor [4].PortInterrupt:=@SeriellIntrProc4;
  1443.   SeriellDiscriptor [5].PortInterrupt:=@SeriellIntrProc5;
  1444.   SeriellDiscriptor [6].PortInterrupt:=@SeriellIntrProc6;
  1445.   SeriellDiscriptor [7].PortInterrupt:=@SeriellIntrProc7;
  1446.   SeriellDiscriptor [8].PortInterrupt:=@SeriellIntrProc8;
  1447.  
  1448.   altexitproc:=ExitProc;
  1449.   ExitProc:=@SeriellInterfaceExit;
  1450.  
  1451.   SeriellError:=0;
  1452.   SeriellOk:=TRUE;
  1453.   FiFoAktiv:=TRUE;
  1454. END.  (* of UNIT SeriellInterface *)